home *** CD-ROM | disk | FTP | other *** search
/ Software Vault: The Gold Collection / Software Vault - The Gold Collection (American Databankers) (1993).ISO / cdr49 / sider.zip / ASK.LIB next >
Text File  |  1993-06-16  |  2KB  |  83 lines
  1. {************************************************************************}
  2. function video_pg: byte;                       {returns active video page}
  3. var page : byte absolute $0000:$0462;          {required by w_col, and   }
  4. begin                                          {read1 functions}
  5.   video_pg := page;
  6. end;
  7. {*************************************************************************}
  8. function w_col: integer;                           {cursor at which column}
  9. begin
  10.   r.ah := $03;
  11.   r.bh := video_pg;
  12.   intr($10,r);
  13.   w_col := r.dl +1;
  14. end;
  15. {*************************************************************************}
  16. function read1 : char;               {read directly from the video display}
  17. begin
  18.   r.ah := $08;
  19.   r.bh := video_pg;
  20.   intr($10,r);
  21.   read1 := chr(r.al);
  22. end;
  23. {*************************************************************************}
  24. procedure input(ask :str24; col,row,long : integer);
  25. const bell         = 7;
  26.       back_space   = 8;
  27.       return       = 13;
  28.       escape       = 27;
  29.       lt_arrow     = 75;
  30.       rt_arrow     = 77;
  31. var start,stop : integer;
  32. begin
  33.   answer := '';
  34.   gotoxy(col,row);write(ask);
  35.   start := col + length(ask) +2;
  36.   stop  := start + long;
  37.   textcolor(0);textbackground(15);
  38.   for i := 0 to long -1 do
  39.     begin
  40.       gotoxy(start +i,row);write(' ');
  41.     end;
  42.   gotoxy(start,row);
  43.   repeat key_in;
  44.     if (w_col = stop) or (w_col > stop) then
  45.       begin
  46.         gotoxy(w_col ,row);
  47.         textbackground(0);
  48.         write(chr(bell));
  49.         write('  ');
  50.         textbackground(15);
  51.         gotoxy(stop-1,row)
  52.       end
  53.     else
  54.       begin
  55.         write(upcase(chr(key)));
  56.         if (key = escape) then exit;
  57.         if (key = back_space) then
  58.           begin
  59.             write(' ');
  60.             gotoxy(w_col -1,row);
  61.           end;
  62.         if (s_code = lt_arrow) then
  63.           begin
  64.             gotoxy(w_col -2,row);
  65.             write(' ');
  66.             gotoxy(w_col -1,row);
  67.           end;
  68.         if (w_col <start) then
  69.           begin
  70.             gotoxy(start-1,row);
  71.             textbackground(0);write(' ');textbackground(15);
  72.             gotoxy(start,row);
  73.           end;
  74.     end;
  75.   until key = return;
  76.   for i := 1 to long do
  77.     begin
  78.       gotoxy(start -1 +i,row);
  79.       insert(read1,answer,i);
  80.     end;
  81.   normvideo;
  82. end;
  83. {*************************************************************************}